home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / wsc4d21.zip / TERM_PGM.PAS < prev    next >
Pascal/Delphi Source File  |  1997-06-09  |  17KB  |  637 lines
  1. unit Term_pgm;
  2.  
  3. interface
  4.  
  5. uses
  6.   DisplayUnit,
  7.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  8.   Forms, Dialogs, Menus,
  9.   ExtCtrls, StdCtrls,
  10.   wsc, mio, xydrive;
  11. const
  12.   NAK = $15;
  13.   CR = 13;
  14.   LF = 10;
  15.   BS = 8;
  16.   DebugLevel = 0; (* XY Driver debug level [0,1,2] *)
  17.   XMODEM = 0;
  18.   YMODEM = 1;
  19. type
  20.   TTerm = class(TForm)
  21.     MainMenu: TMainMenu;
  22.     menuLine: TMenuItem;
  23.     menuOnLine: TMenuItem;
  24.     menuOffline: TMenuItem;
  25.     menuExit: TMenuItem;
  26.     menuChange: TMenuItem;
  27.     menuPort: TMenuItem;
  28.     menuBaud: TMenuItem;
  29.     menuDataBits: TMenuItem;
  30.     menuParity: TMenuItem;
  31.     menuStopBits: TMenuItem;
  32.     menuDial: TMenuItem;
  33.     menuSend: TMenuItem;
  34.     menuCOM1: TMenuItem;
  35.     menuCOM2: TMenuItem;
  36.     menuCOM3: TMenuItem;
  37.     menuCOM4: TMenuItem;
  38.     menu2400: TMenuItem;
  39.     menu9600: TMenuItem;
  40.     menu19200: TMenuItem;
  41.     menu38400: TMenuItem;
  42.     menu57600: TMenuItem;
  43.     menuSeven: TMenuItem;
  44.     menuEight: TMenuItem;
  45.     menuNone: TMenuItem;
  46.     menuEven: TMenuItem;
  47.     MenuOdd: TMenuItem;
  48.     menuOne: TMenuItem;
  49.     menuTwo: TMenuItem;
  50.     Timer: TTimer;
  51.     AboutPanel: TPanel;
  52.     AboutOK: TButton;
  53.     AboutMemo: TMemo;
  54.     menuReceive: TMenuItem;
  55.     RXMODEM: TMenuItem;
  56.     RYMODEM: TMenuItem;
  57.     menuBreak: TMenuItem;
  58.     menuAbout: TMenuItem;
  59.     SXMODEM: TMenuItem;
  60.     SYMODEM: TMenuItem;
  61.     AcceptPanel: TPanel;
  62.     AcceptMemo: TMemo;
  63.     AcceptOK: TButton;
  64.     menuDebug: TMenuItem;
  65.     Memo: TMemo;
  66.     AcceptBox: TMemo;
  67.     procedure FormCreate(Sender: TObject);
  68.     procedure menuOnLineClick(Sender: TObject);
  69.     procedure menuOfflineClick(Sender: TObject);
  70.     procedure menuCOM1Click(Sender: TObject);
  71.     procedure menuCOM2Click(Sender: TObject);
  72.     procedure menuCOM3Click(Sender: TObject);
  73.     procedure menuCOM4Click(Sender: TObject);
  74.     procedure menuExitClick(Sender: TObject);
  75.     procedure menu2400Click(Sender: TObject);
  76.     procedure menu9600Click(Sender: TObject);
  77.     procedure menu19200Click(Sender: TObject);
  78.     procedure menu38400Click(Sender: TObject);
  79.     procedure menu57600Click(Sender: TObject);
  80.     procedure menuSevenClick(Sender: TObject);
  81.     procedure menuEightClick(Sender: TObject);
  82.     procedure menuNoneClick(Sender: TObject);
  83.     procedure menuEvenClick(Sender: TObject);
  84.     procedure MenuOddClick(Sender: TObject);
  85.     procedure menuOneClick(Sender: TObject);
  86.     procedure menuTwoClick(Sender: TObject);
  87.     procedure TimerTimer(Sender: TObject);
  88.     procedure KeyPress(Sender: TObject; var Key: Char);
  89.     procedure AboutOKClick(Sender: TObject);
  90.     procedure menuAboutClick(Sender: TObject);
  91.     procedure menuDialClick(Sender: TObject);
  92.     procedure AcceptOKClick(Sender: TObject);
  93.     procedure menuBreakClick(Sender: TObject);
  94.     procedure SXMODEMClick(Sender: TObject);
  95.     procedure SYMODEMClick(Sender: TObject);
  96.     procedure RXMODEMClick(Sender: TObject);
  97.     procedure RYMODEMClick(Sender: TObject);
  98.     procedure XY(Sender: TObject);
  99.  
  100.   private
  101.     { Private declarations }
  102.     LastPacket : Integer;
  103.     NewState : Integer;
  104.     mioState : Integer;
  105.     xyState  : Integer;
  106.     Port : Integer;
  107.     Baud : Integer;
  108.     Parity : Integer;
  109.     DataBits : Integer;
  110.     StopBits : Integer;
  111.   public
  112.     { Public declarations }
  113.   end ;
  114.  
  115. var
  116.   Term: TTerm;
  117.  
  118. implementation
  119.  
  120. {$R *.DFM}
  121.  
  122. procedure TTerm.FormCreate(Sender: TObject);
  123. var
  124.   I    : Integer;
  125.   Code : Integer;
  126. begin
  127.   (* initialize canvas *)
  128.   menuBreak.Enabled := False;
  129.  (* initialize parameters *)
  130.   Port := COM1;
  131.   Baud := Baud19200;
  132.   Parity := NoParity;
  133.   DataBits := WordLength8;
  134.   StopBits := OneStopBit;
  135.   (* initialize menu settings *)
  136.   menuOffLine.Checked := true;
  137.   menuCOM1.Checked := true;
  138.   menu19200.Checked := true;
  139.   menuNone.Checked := true;
  140.   menuEight.Checked := true;
  141.   menuOne.Checked := true;
  142.   (* initialize state variables *)
  143.   mioState := 0;
  144.   xyState := 0;
  145.   xyDebug(DebugLevel);
  146.   DisplayLine(Memo,'FORM created');
  147. end;
  148.  
  149. procedure TTerm.menuOnLineClick(Sender: TObject);
  150. var      
  151.   Code : Integer;
  152. begin
  153.   (* initialize WSC *)
  154.   Code := SioReset(Port,2048,2048);
  155.   if Code < 0 then
  156.     begin
  157.       DisplayLine(Memo,Format('Error %d: Cannot reset port',[Code]));
  158.       DisplayError(Memo, Code);
  159.       exit
  160.     end;
  161.   (* set hardware flow control *)
  162.   Code := SioFlow(Port,'H');
  163.   DisplayLine(Memo,'Waiting for DSR...');
  164.   (* attach XYDRIVER *)
  165.   Code := xyAcquire(Port);
  166.   (* update menu settings *)
  167.   Term.Caption := 'Term: COM' + Chr($31+Port) + ' Online';
  168.   menuOnLine.Checked := true;
  169.   menuOffLine.Checked := false;
  170.   menuChange.Enabled := false;
  171.   menuSend.Enabled := true;
  172.   menuReceive.Enabled := true;
  173.   menuDial.Enabled := true;
  174.   Code := SioBaud(Port,Baud);
  175.   Code := SioParms(Port, Parity, StopBits, DataBits);
  176.   Code := SioDTR(Port,'S');
  177.   Code := SioRTS(Port,'S');
  178.   Memo.SetFocus
  179. end;
  180.  
  181. procedure TTerm.menuOfflineClick(Sender: TObject);
  182. var
  183.   Code : Integer;
  184. begin
  185.   Term.Caption := 'Term: Offline';
  186.   DisplayString(Memo,'Shutting down COM port');
  187.   menuOnLine.Checked := false;
  188.   menuOffLine.Checked := true;
  189.   menuChange.Enabled := true;
  190.   menuSend.Enabled := false;
  191.   menuReceive.Enabled := false;
  192.   menuDial.Enabled := false;
  193.   Code := xyRelease(Port);
  194.   Code := SioDone(Port)
  195. end;
  196.  
  197. procedure TTerm.menuCOM1Click(Sender: TObject);
  198. begin
  199.   menuCOM1.Checked := true;
  200.   menuCOM2.Checked := false;
  201.   menuCOM3.Checked := false;
  202.   menuCOM4.Checked := false;
  203.   Port := COM1
  204. end;
  205.  
  206. procedure TTerm.menuCOM2Click(Sender: TObject);
  207. begin
  208.   menuCOM1.Checked := false;
  209.   menuCOM2.Checked := true;
  210.   menuCOM3.Checked := false;
  211.   menuCOM4.Checked := false;
  212.   Port := COM2
  213. end;
  214.  
  215. procedure TTerm.menuCOM3Click(Sender: TObject);
  216. begin
  217.   menuCOM1.Checked := false;
  218.   menuCOM2.Checked := false;
  219.   menuCOM3.Checked := true;
  220.   menuCOM4.Checked := false;
  221.   Port := COM3
  222. end;
  223.  
  224. procedure TTerm.menuCOM4Click(Sender: TObject);
  225. begin
  226.   menuCOM1.Checked := false;
  227.   menuCOM2.Checked := false;
  228.   menuCOM3.Checked := false;
  229.   menuCOM4.Checked := true;
  230.   Port := COM4
  231. end;
  232.  
  233. procedure TTerm.menuExitClick(Sender: TObject);
  234. var
  235.   Code : Integer;
  236. begin
  237.   Code := SioDone(Port);
  238.   Application.Terminate;
  239. end;
  240.  
  241. procedure TTerm.menu2400Click(Sender: TObject);
  242. begin
  243.   menu2400.Checked := true;
  244.   menu9600.Checked := false;
  245.   menu19200.Checked := false;
  246.   menu38400.Checked := false;
  247.   menu57600.Checked := false;
  248.   Baud := Baud2400
  249. end;
  250.  
  251. procedure TTerm.menu9600Click(Sender: TObject);
  252. begin
  253.   menu2400.Checked := false;
  254.   menu9600.Checked := true;
  255.   menu19200.Checked := false;
  256.   menu38400.Checked := false;
  257.   menu57600.Checked := false;
  258.   Baud := Baud9600
  259. end;
  260.  
  261. procedure TTerm.menu19200Click(Sender: TObject);
  262. begin
  263.   menu2400.Checked := false;
  264.   menu9600.Checked := false;
  265.   menu19200.Checked := true;
  266.   menu38400.Checked := false;
  267.   menu57600.Checked := false;
  268.   Baud := Baud19200
  269. end;
  270.  
  271. procedure TTerm.menu38400Click(Sender: TObject);
  272. begin
  273.   menu2400.Checked := false;
  274.   menu9600.Checked := false;
  275.   menu19200.Checked := false;
  276.   menu38400.Checked := true;
  277.   menu57600.Checked := false;
  278.   Baud := Baud38400
  279. end;
  280.  
  281. procedure TTerm.menu57600Click(Sender: TObject);
  282. begin
  283.   menu2400.Checked := false;
  284.   menu9600.Checked := false;
  285.   menu19200.Checked := false;
  286.   menu38400.Checked := false;
  287.   menu57600.Checked := true;
  288.   Baud := Baud57600
  289. end;
  290.  
  291. procedure TTerm.menuSevenClick(Sender: TObject);
  292. begin
  293.   menuSeven.Checked := true;
  294.   menuEight.Checked := false;
  295.   DataBits := WordLength7
  296. end;
  297.  
  298. procedure TTerm.menuEightClick(Sender: TObject);
  299. begin
  300.   menuSeven.Checked := false;
  301.   menuEight.Checked := true;
  302.   DataBits := WordLength8
  303. end;
  304.  
  305. procedure TTerm.menuNoneClick(Sender: TObject);
  306. begin
  307.   menuNone.Checked := true;
  308.   menuEven.Checked := false;
  309.   menuOdd.Checked := false;
  310.   Parity := NoParity
  311. end;
  312.  
  313. procedure TTerm.menuEvenClick(Sender: TObject);
  314. begin
  315.   menuNone.Checked := false;
  316.   menuEven.Checked := true;
  317.   menuOdd.Checked := false;
  318.   Parity := EvenParity
  319. end;
  320.  
  321. procedure TTerm.MenuOddClick(Sender: TObject);
  322. begin
  323.   menuNone.Checked := false;
  324.   menuEven.Checked := false;
  325.   menuOdd.Checked := true;
  326.   Parity := OddParity
  327. end;
  328.  
  329. procedure TTerm.menuOneClick(Sender: TObject);
  330. begin
  331.   menuOne.Checked := true;
  332.   menuTwo.Checked := false;
  333.   StopBits := OneStopBit
  334. end;
  335.  
  336. procedure TTerm.menuTwoClick(Sender: TObject);
  337. begin
  338.   menuOne.Checked := false;
  339.   menuTwo.Checked := true;
  340.   StopBits := TwoStopBits
  341. end;
  342.  
  343. procedure TTerm.TimerTimer(Sender: TObject);
  344. var
  345.   I     : Integer;
  346.   Code  : Integer;
  347.   Result: Integer;
  348.   Ptr   : PChar;
  349.   Text  : String;
  350.   Count : Integer;
  351.   C     : Char;
  352.   Packet  : Integer;
  353.   ErrorState : Integer;
  354.   CharCount : Integer;
  355.   S : String;
  356. begin
  357.   S  := '';
  358.   CharCount := 0;
  359.   if xyState <> 0 then
  360.     begin
  361.       case xyState of
  362.      10: begin (* XM Send *)
  363.            GetMem(Ptr,32);
  364.            StrPCopy(Ptr,AcceptBox.Text);
  365.            Code := xyStartTx(Port,Ptr,0,XMODEM);
  366.            xyState := 50;
  367.            FreeMem(Ptr,32);
  368.          end;
  369.      20: begin  (* YM Send *)
  370.            GetMem(Ptr,32);
  371.            StrPCopy(Ptr,AcceptBox.Text);
  372.            Code := xyStartTx(Port,Ptr,0,YMODEM);
  373.            xyState := 50;
  374.            FreeMem(Ptr,32)
  375.          end;
  376.      30: begin  (* XM Receive *)
  377.            GetMem(Ptr,32);
  378.            StrPCopy(Ptr,AcceptBox.Text);
  379.            Code := xyStartRx(Port,Ptr,CHR(NAK),XMODEM);
  380.            xyState := 50;
  381.            FreeMem(Ptr,32)
  382.          end;
  383.      40: begin   (* YM Receive *)
  384.            GetMem(Ptr,32);
  385.            StrPCopy(Ptr,'');
  386.            Code := xyStartRx(Port,Ptr,'C',YMODEM);
  387.            xyState := 50;
  388.            LastPacket := -1;
  389.            FreeMem(Ptr,32)
  390.          end;
  391.      50: begin   (* xyDriver *)
  392.            GetMem(Ptr,90);
  393.            while true do
  394.              begin
  395.                if xyGetMessage(Ptr,90) <> 0 then
  396.                  begin
  397.                    Text := StrPas(Ptr);
  398.                    DisplayLine(Memo,Text)
  399.                  end
  400.                else break;
  401.              end;
  402.            FreeMem(Ptr,90);
  403.            if xyDriver(Port) = MIO_IDLE then
  404.              begin
  405.                (* xy state driver is idle *)
  406.                xyState := 0;
  407.                ErrorState := xyGetParameter(Port,XY_GET_ERROR_CODE);
  408.                if ErrorState <> 0 then
  409.                  begin
  410.                    DisplayLine(Memo,Format('File transfer fails (%d)',[ErrorState]));
  411.                  end
  412.                else DisplayLine(Memo,'File transfer complete');
  413.                (* restore menu buttons *)
  414.                Memo.SetFocus;
  415.                menuBreak.Enabled := false;
  416.                menuDial.Enabled := true;
  417.                menuSend.Enabled := true;
  418.                menuReceive.Enabled := true;
  419.                menuBreak.Enabled := false
  420.              end
  421.            else
  422.              begin
  423.                (* xy state driver is running *)
  424.                Packet := xyGetParameter(Port,XY_GET_PACKET);
  425.                if (Packet <> LastPacket) and (DebugLevel = 0) then
  426.                  begin
  427.                    (*DisplayChar(Memo,Chr(CR));*)
  428.                    DisplayLine(Memo, Format('Packet %d',[Packet]) );
  429.                    LastPacket := Packet
  430.                  end
  431.              end;
  432.           end;
  433.       else
  434.         xyState := 0;
  435.       end
  436.     end
  437.   else if mioState <> 0 then
  438.     begin
  439.       case mioState of
  440.       1: begin
  441.            if Length(AcceptBox.Text) = 0 then
  442.              begin
  443.                DisplayLine(Memo,'Missing phone number');
  444.                Memo.SetFocus;
  445.                mioState := 0;
  446.              end
  447.            else
  448.              begin
  449.                menuBreak.Enabled := true;
  450.                menuDial.Enabled := false;
  451.                Text := '!ATDT' + AcceptBox.Text + '!';
  452.                DisplayLine(Memo,Text);
  453.                GetMem(Ptr,32);
  454.                StrPCopy(Ptr,Text);
  455.                mioSendTo(Port,100,Ptr);
  456.                FreeMem(Ptr,32);
  457.                mioState := 2
  458.              end
  459.          end;
  460.       2: begin
  461.            if mioDriver(Port) = MIO_IDLE then
  462.              begin
  463.                Text := 'CONNECT';
  464.                GetMem(Ptr,32);
  465.                StrPCopy(Ptr,Text);
  466.                mioWaitFor(Port,60000,Ptr);
  467.                FreeMem(Ptr,32);
  468.                mioState := 3
  469.              end
  470.          end;
  471.       3: begin
  472.            if mioDriver(Port) = MIO_IDLE then
  473.            begin
  474.              mioState := 0;
  475.              menuBreak.Enabled := false;
  476.              menuDial.Enabled := true;
  477.              Memo.SetFocus;
  478.              if mioResult(Port) <> 0 then DisplayLine(Memo,'[CONNECT was received]')
  479.              else
  480.                begin
  481.                  DisplayLine(Memo,'[CONNECT was NOT received]')
  482.                end
  483.            end
  484.          end
  485.       end (* case *)
  486.     end (* else(mioState<>0) *)
  487.   else
  488.     begin
  489.       (* gather all serial input *)
  490.        for I := 1 to 128 do
  491.          begin
  492.            Code := SioGetc(Port);
  493.            if Code < 0 then break;
  494.            if Chr(Code) <> Chr(13) then
  495.              begin
  496.                {got character (other than CR)}
  497.                Inc(CharCount);
  498.                if Chr(Code) = Chr(10) then break;
  499.                S := S + Chr(Code);
  500.              end
  501.          end; {for}
  502.      {display}
  503.      if CharCount > 0 then DisplayString(Memo,S);
  504.      if Chr(Code) = Chr(10) then DisplayChar(Memo,Chr(10))
  505.   end
  506. end;
  507.  
  508. procedure TTerm.KeyPress(Sender: TObject; var Key: Char);
  509. var
  510.   Code : Integer;
  511. begin
  512.   Code := SioPutc(Port,Key);
  513.   if(Code<WSC_NO_DATA)
  514.   then DisplayLine(Memo,Format('SioPutc error %d',[Code]));
  515. end;
  516.  
  517. procedure TTerm.AboutOKClick(Sender: TObject);
  518. begin
  519.    AboutPanel.Visible := False
  520. end;
  521.  
  522. procedure TTerm.menuAboutClick(Sender: TObject);
  523. begin
  524.      AboutPanel.Visible := True
  525. end;
  526.  
  527. procedure TTerm.menuDialClick(Sender: TObject);
  528. begin
  529.    AcceptMemo.Lines.Clear;
  530.    AcceptMemo.Lines.Add('Enter phone number');
  531.    AcceptBox.Lines.Clear;
  532.    AcceptPanel.Visible := true;
  533.    AcceptBox.SetFocus;
  534.    NewState := 1
  535. end;
  536.  
  537. procedure TTerm.AcceptOKClick(Sender: TObject);
  538. begin
  539.   AcceptPanel.Visible := false;
  540.   DisplayLine(Memo,AcceptBox.Text);
  541.   (* set state variable after get Accept text *)
  542.   if NewState = 1 then mioState := 1
  543.   else xyState := NewState;
  544.   NewState := 0;
  545. end;
  546.  
  547. procedure TTerm.menuBreakClick(Sender: TObject);
  548. begin
  549.    mioState := 0;
  550.    xyState := 0;
  551.    mioBreak(Port);
  552.    xyAbort(Port);
  553.    menuDial.Enabled := true;
  554.    menuSend.Enabled := true;
  555.    menuReceive.Enabled := true;
  556.    menuBreak.Enabled := false;
  557.    Memo.SetFocus;
  558. end;
  559.  
  560. procedure TTerm.SXMODEMClick(Sender: TObject);
  561. begin
  562.   AcceptMemo.Lines.Clear;
  563.   AcceptMemo.Lines.Add('XMODEM file name');
  564.   AcceptPanel.Visible := true;
  565.   menuBreak.Enabled := true;
  566.   AcceptBox.Lines.Clear;
  567.   AcceptBox.SetFocus;
  568.   NewState := 10
  569. end;
  570.  
  571. procedure TTerm.SYMODEMClick(Sender: TObject);
  572. begin
  573.   AcceptMemo.Lines.Clear;
  574.   AcceptMemo.Lines.Add('YMODEM file name');
  575.   AcceptPanel.Visible := true;
  576.   menuBreak.Enabled := true;
  577.   AcceptBox.Lines.Clear;
  578.   AcceptBox.SetFocus;
  579.   NewState := 20
  580. end;
  581.  
  582. procedure TTerm.RXMODEMClick(Sender: TObject);
  583. begin
  584.   AcceptMemo.Lines.Clear;
  585.   AcceptMemo.Lines.Add('XMODEM file name');
  586.   AcceptPanel.Visible := true;
  587.   menuBreak.Enabled := true;
  588.   AcceptBox.Lines.Clear;
  589.   AcceptBox.SetFocus;
  590.   NewState := 30
  591. end;
  592.  
  593. procedure TTerm.RYMODEMClick(Sender: TObject);
  594. begin
  595.   (* set xy state variable directly *)
  596.   menuBreak.Enabled := true;
  597.   xyState := 40
  598. end;
  599.  
  600. procedure TTerm.XY(Sender: TObject);
  601. var
  602.   Ptr : PChar;
  603.   Text : String;
  604.   Parm : LongInt;
  605. begin
  606.   GetMem(Ptr,80);
  607.   while true do
  608.   begin
  609.     if xyGetMessage(Ptr,80) <> 0 then
  610.       begin
  611.         Text := StrPas(Ptr);
  612.         DisplayLine(Memo,Text)
  613.       end
  614.     else break;
  615.   end;
  616.   FreeMem(Ptr,80);
  617.   (* display current state *)
  618.   Parm := xyGetParameter(Port,XY_GET_STATE);
  619.   DisplayString(Memo,'STATE =');
  620.   DisplayLine(Memo,Format('%d',[Parm]));
  621.   (* display error code *)
  622.   Parm := xyGetParameter(Port,XY_GET_ERROR_CODE);
  623.   if Parm <> 0 then
  624.     begin
  625.       DisplayLine(Memo,Format('ERROR Code = %d',[Parm]));
  626.       DisplayLine(Memo,Format('ERROR State = %d',
  627.                     [xyGetParameter(Port,XY_GET_ERROR_STATE)] ));
  628.     end;
  629.   (* display driver count *)
  630.   Parm := xyGetParameter(Port,XY_GET_DRIVER_COUNT);
  631.   DisplayLine(Memo, Format('xyDriver Count = %d',[Parm]) );
  632.   (* Display state variables *)
  633.   DisplayLine(Memo, Format('xyState = %d',[xyState]) );
  634. end;
  635.  
  636. end.
  637.